home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 1 / Meeting Pearls Vol 1 (1994).iso / amok98-106 / amok101 / brush2icon / brush2icon.mod < prev    next >
Text File  |  1993-08-26  |  14KB  |  584 lines
  1. (*---------------------------------------------------------------------------
  2. :Program.       Brush2Icon.mod
  3. :Contents.      Converts IFF brushes to icons
  4. :Author.        Achim Siebert
  5. :Address.       Nobileweg 67, 7000 Stuttgart 40
  6. :Copyright.     PD
  7. :Language.      Oberon
  8. :Translator.    Amiga Oberon V3.00d
  9. :History.       V1.3, 02.12.92
  10. :History.       V1.4, 26.08.93
  11. :Usage.         Brush2Icon BrushOrIcon/A,BrushOrFile/A,Files/M,T=DefaultTool/K,Replace/S,Dirs/S
  12. ---------------------------------------------------------------------------*)
  13.  
  14. MODULE Brush2Icon;
  15.  
  16. IMPORT
  17.   NoGuru,
  18.   a  : Arguments,
  19.   s  : SYSTEM,
  20.   fs : FileSystem,
  21.   st : Strings,
  22.   e  : Exec,
  23.   ol : OberonLib,
  24.   I  : Intuition,
  25.   Icon,
  26.   WB: Workbench,
  27.   Dos,
  28.   Requests;
  29.  
  30. CONST
  31.   readerr  = "Read error\n";
  32.   nomem    = "Out of memory\n";
  33.   usage    = "Usage: Brush2Icon BrushOrIcon [Brush2] {Files}";
  34.  
  35. CONST  (* Masking *)
  36.   mskHasMask = 1;
  37.  
  38. CONST (* Compression *)
  39.   cmpByteRun = 1;
  40.  
  41. TYPE
  42.   BitMapHeader = STRUCT
  43.     width,height          : INTEGER;
  44.     x,y                   : INTEGER;
  45.     nPlanes               : SHORTINT;
  46.     masking               : SHORTINT;
  47.     compression           : SHORTINT;
  48.     pad1                  : SHORTINT;
  49.     transparentColor      : INTEGER;
  50.     xAspect,yAspect       : SHORTINT;
  51.     pageWidth,pageHeight  : INTEGER;
  52.   END;
  53.  
  54. CONST (* Action *)
  55.   copy   = 0;
  56.   extend = 1;
  57.   nop    = 2;
  58.  
  59. VAR
  60.   arg,deftool,b1,b2 : e.STRING;
  61.   argNr       : INTEGER;
  62.   in          : fs.File;
  63.   chunk,id,len: LONGINT;
  64.   bmhd        : BitMapHeader;
  65.   bmhdFlag    : BOOLEAN;
  66.   wordsPerLine: INTEGER;
  67.   size,oc     : LONGINT;
  68.   firstLong   : LONGINT;
  69.   x,y,z       : INTEGER;
  70.   compressed  : BOOLEAN;
  71.   zaehler     : LONGINT;
  72.   store,action: SHORTINT;
  73.  
  74.   WDO         : WB.DiskObject;
  75.   OldWDO      : WB.DiskObjectPtr;
  76.   SourceWDO   : WB.DiskObjectPtr;
  77.  
  78.   gad         : I.Gadget;
  79.   Images      : ARRAY 2 OF I.Image;
  80.   IntArray    : UNTRACED POINTER TO ARRAY OF INTEGER;
  81.   drawerData  : WB.DrawerData;
  82.  
  83.   lock,parent : Dos.FileLockPtr;
  84.   myFIBlock   : Dos.FileInfoBlock;
  85.  
  86.   source      : INTEGER;
  87.  
  88.   replace     : BOOLEAN;
  89.   dirs        : BOOLEAN;
  90.   doWild,done : BOOLEAN;
  91.  
  92.   rdargs      : Dos.RDArgsPtr;
  93.  
  94.   args        : STRUCT
  95.                    b1   : e.STRPTR;
  96.                    b2   : e.STRPTR;
  97.                    files: POINTER TO ARRAY 256 OF e.STRPTR;
  98.                    def  : e.STRPTR;
  99.                    rep  : LONGINT;
  100.                    dirs : LONGINT;
  101.                  END;
  102.  
  103.   anchor      : Dos.AnchorPath;
  104.  
  105. CONST (* kinds of source *)
  106.       icon      = 0;
  107.       brush     = 1;
  108.       brushes   = 2;
  109.       plainfile = 3;
  110.  
  111. PROCEDURE Read(VAR to: ARRAY OF s.BYTE);
  112. BEGIN
  113.   IF ~fs.Read(in,to) THEN
  114.     IF fs.Close(in) THEN END;
  115.     Requests.Assert(FALSE,readerr);
  116.   END;
  117. END Read;
  118.  
  119. PROCEDURE NextWord():INTEGER;
  120.  
  121. VAR uword : INTEGER;
  122.     ubyte : SHORTINT;
  123.     bytes : INTEGER;
  124.     n     : SHORTINT;
  125.  
  126. BEGIN
  127.  
  128.   IF NOT compressed THEN
  129.     Read(uword);
  130.     RETURN uword
  131.   END;
  132.   uword := 0; bytes := 0;
  133.   REPEAT
  134.     IF zaehler=0 THEN
  135.       Read(n);
  136.       IF n >= 0 THEN
  137.         zaehler := n+1;
  138.         action := copy;
  139.       ELSIF n # -128 THEN
  140.         zaehler:= (-n)+1;
  141.         action := extend;
  142.         Read(store);
  143.       ELSE
  144.         action := nop;
  145.       END;
  146.     ELSE
  147.       CASE action OF
  148.       | copy:   Read(ubyte);
  149.       | extend: ubyte := store
  150.       | nop:
  151.       END;
  152.       (* $OvflChk- *)
  153.       uword := s.LSH(uword,8);
  154.       IF ubyte >= 0 THEN
  155.         uword := uword + ubyte
  156.       ELSE
  157.         uword := uword + (LONG(ubyte)+256)
  158.       END;
  159.       (* $OvflChk= *)
  160.       DEC(zaehler);
  161.       INC(bytes);
  162.     END;
  163.   UNTIL bytes=2;
  164.   RETURN uword;
  165.  
  166. END NextWord;
  167.  
  168.  
  169. PROCEDURE ReadBrush(num:INTEGER):BOOLEAN;
  170.  
  171. VAR temp:LONGINT;
  172.  
  173. BEGIN
  174.  
  175.   IF fs.Open(in,arg,FALSE) THEN
  176.  
  177.     Read(chunk);
  178.     IF chunk = s.VAL(LONGINT,"FORM") THEN
  179.       Read(len);
  180.       Read(id);
  181.       IF id = s.VAL(LONGINT,"ILBM") THEN
  182.  
  183.         zaehler := 0;
  184.         bmhdFlag := FALSE;
  185.  
  186.         LOOP
  187.           Read(chunk);  Read(len);
  188.           IF ODD(len) THEN INC(len) END;
  189.  
  190.           IF chunk = s.VAL(LONGINT,"BODY") THEN
  191.             IF NOT bmhdFlag THEN
  192.               IF fs.Close(in) THEN END;
  193.               RETURN FALSE;
  194.             END;
  195.  
  196.             wordsPerLine := (bmhd.width+15) DIV 16;
  197.             compressed   := (bmhd.compression=cmpByteRun);
  198.  
  199.             size := LONG(wordsPerLine) * bmhd.height * bmhd.nPlanes;
  200.  
  201.             NEW(IntArray,size);
  202.  
  203.             FOR y:=0 TO bmhd.height-1 DO
  204.               FOR z:=0 TO (bmhd.nPlanes-1) DO
  205.                 temp := (LONG(y) + z * bmhd.height) * wordsPerLine;
  206.                 FOR x:=0 TO wordsPerLine-1 DO
  207.                   IntArray[temp + x] := NextWord();
  208.                 END;
  209.               END;
  210.               IF bmhd.masking=mskHasMask THEN
  211.                 FOR x:=0 TO wordsPerLine-1 DO
  212.                   IF NextWord()=0 THEN END;
  213.                 END;
  214.               END;
  215.             END;
  216.  
  217.             Images[num].width     := bmhd.width;
  218.             Images[num].height    := bmhd.height;
  219.             Images[num].depth     := bmhd.nPlanes;
  220.             Images[num].imageData := s.ADR(IntArray^);
  221.             Images[num].planePick := SHORTSET{3};
  222.             Images[num].planeOnOff:= SHORTSET{0};
  223.  
  224.             EXIT;
  225.           END;
  226.           IF chunk = s.VAL(LONGINT,"BMHD") THEN
  227.  
  228.             Read(bmhd);
  229.             bmhdFlag := TRUE;
  230.  
  231.           ELSE
  232.  
  233.             IF ~fs.Forward(in,len) THEN
  234.               IF fs.Close(in) THEN END;
  235.               Requests.Assert(FALSE,readerr);
  236.             END;
  237.  
  238.           END;
  239.         END; (* LOOP *)
  240.         IF fs.Close(in) THEN END;
  241.         RETURN TRUE;
  242.       END;
  243.     END;
  244.     IF fs.Close(in) THEN END;
  245.   END; (* IF fs.Open *)
  246.   RETURN FALSE;
  247.  
  248. END ReadBrush;
  249.  
  250.  
  251. PROCEDURE StripInfo(VAR tostrip:ARRAY OF CHAR);
  252.  
  253. VAR i : LONGINT;
  254.  
  255. BEGIN
  256.  
  257.   IF ~ol.wbStarted THEN
  258.     i := st.Occurs(tostrip,".info");
  259.     IF (i#-1) AND (i=st.Length(tostrip)-5) THEN
  260.       tostrip[st.Length(tostrip)-5]:=0X;
  261.     END;
  262.   END;
  263.  
  264. END StripInfo;
  265.  
  266. PROCEDURE GetTools();
  267.  
  268. VAR string : e.STRPTR;
  269.     MyName : ARRAY 32 OF CHAR;
  270.     wbdop  : WB.DiskObjectPtr;
  271.  
  272.  
  273.    PROCEDURE FindTool(findstr: ARRAY OF CHAR):BOOLEAN;
  274.  
  275.    BEGIN
  276.  
  277.      string := Icon.FindToolType(wbdop.toolTypes,findstr);
  278.      IF string # NIL THEN RETURN TRUE END;
  279.      RETURN FALSE;
  280.  
  281.    END FindTool;
  282.  
  283.  
  284. BEGIN
  285.  
  286.   a.GetArg(0,MyName);
  287.   IF MyName # "" THEN
  288.      wbdop := Icon.GetDiskObject(MyName);
  289.      IF wbdop # NIL THEN
  290.         IF FindTool("DEFTOOL") THEN
  291.           deftool := string^;
  292.         END;
  293.         IF FindTool("REPLACE") THEN
  294.           replace:=TRUE;
  295.         END;
  296.         Icon.FreeDiskObject(wbdop);
  297.      END;
  298.   END;
  299.  
  300. END GetTools;
  301.  
  302.  
  303. PROCEDURE GetArgs();
  304.  
  305. BEGIN
  306.  
  307.   rdargs := Dos.ReadArgs("BrushOrIcon/A,BrushOrFile/A,Files/M,T=DefaultTool/K,REPLACE/S,DIRS/S",args,NIL);
  308.  
  309.   IF rdargs=NIL THEN IF Dos.PutStr(
  310.                 "\nUsage: BrushOrIcon/A:   IFF-Brush for icon image or existing icon\n"
  311.                   "       BrushOrFile/A:   optional second brush for highlighted icon\n"
  312.                   "                        or first destination file\n"
  313.                   "       Files/M:         files to get the new icon, wildcards allowed\n"
  314.                   "       T=DefaultTool/K: default tool for project icons\n"
  315.                   "       REPLACE/S:       replace existing default tools\n"
  316.                   "       DIRS/S:          if using wildcards, change drawer icons only\n"
  317.                   )#0 THEN END;
  318.      HALT(10);
  319.   END;
  320.   IF args.b1#NIL THEN
  321.      b1 := args.b1^;
  322.   END;
  323.   IF args.b2#NIL THEN
  324.      b2 := args.b2^;
  325.   END;
  326.   IF args.def#NIL THEN
  327.      deftool := args.def^;
  328.   END;
  329.   replace:=args.rep#0;
  330.   dirs:=args.dirs#0;
  331.  
  332. END GetArgs;
  333.  
  334.  
  335. PROCEDURE NextArg():BOOLEAN;
  336.  
  337. BEGIN
  338.  
  339.   IF ol.wbStarted THEN
  340.     IF argNr>a.NumArgs() THEN RETURN FALSE END;
  341.     a.GetArg(argNr,arg);
  342.   ELSE
  343.     IF argNr=1 THEN
  344.       arg:=b1;
  345.     ELSIF argNr=2 THEN
  346.       arg:=b2;
  347.     ELSIF (args.files # NIL) AND (args.files[argNr-3] # NIL) THEN
  348.       arg := args.files[argNr-3]^;
  349.     ELSE RETURN FALSE;
  350.     END;
  351.   END;
  352.   INC(argNr);
  353.   RETURN TRUE;
  354.  
  355. END NextArg;
  356.  
  357.  
  358. BEGIN
  359.  
  360.   Requests.Assert(I.int.libNode.version>=37,"Kickstart 37.x only!");
  361.  
  362.   deftool := "";
  363.   replace := FALSE;
  364.   dirs    := FALSE;
  365.  
  366.   anchor.strLen:=256;
  367.   anchor.flags:=SHORTSET{Dos.doWild};
  368.  
  369.   IF ol.wbStarted THEN
  370.     Requests.Assert(a.NumArgs()>=1,usage);
  371.     GetTools();
  372.   ELSE
  373.     GetArgs();
  374.   END;
  375.  
  376.   arg := "\o$VER: V1.3 (02.12.92)";
  377.  
  378.   argNr := 1;
  379.  
  380.   IF NextArg() THEN END;
  381.  
  382.   source := icon;
  383.   IF ReadBrush(0) THEN
  384.     source := brush;
  385.     IF NextArg() THEN END;
  386.     IF (ol.wbStarted AND (a.NumArgs()>2))
  387.       OR ((args.files#NIL) AND (args.files[0]#NIL)) THEN
  388.       IF ReadBrush(1) THEN
  389.         source := brushes;
  390.         IF NextArg() THEN END;
  391.       END;
  392.     END;
  393.   END;
  394.  
  395.   IF source=icon THEN
  396.     IF ol.wbStarted AND (arg = "") THEN
  397.       lock:=a.GetLock(1);
  398.       Requests.Assert((lock#NIL) AND Dos.NameFromLock(lock,arg,LEN(arg)),
  399.       "Couldn't access source directory!");
  400.       IF arg[st.Length(arg)-1]=":" THEN
  401.          st.Append(arg,"Disk");
  402.       END;
  403.     END;
  404.     StripInfo(arg);
  405.     SourceWDO := Icon.GetDiskObject(arg);
  406.     IF SourceWDO#NIL THEN
  407.       IF deftool = "" THEN 
  408.         IF (SourceWDO.type = WB.project)
  409.            AND (SourceWDO.defaultTool#NIL) THEN
  410.          deftool := SourceWDO.defaultTool^;
  411.         END;
  412.       END;
  413.       gad := SourceWDO.gadget;
  414.       Requests.Assert(NextArg(),usage);
  415.     ELSE
  416.       IF ol.wbStarted THEN source := plainfile;
  417.       ELSE
  418.         Requests.Assert(FALSE,"Couldn't open source icon!");
  419.       END;
  420.     END;
  421.   ELSE
  422.     IF Images[0].width>Images[1].width THEN
  423.       gad.width    := Images[0].width;
  424.     ELSE
  425.       gad.width    := Images[1].width;
  426.     END;
  427.     IF Images[0].height>Images[1].height THEN
  428.       gad.height     := Images[0].height+1;
  429.     ELSE
  430.       gad.height     := Images[1].height+1;
  431.     END;
  432.     IF source= brush THEN
  433.       gad.flags      := {I.gadgImage};
  434.     ELSE
  435.       gad.flags      := {I.gadgImage,I.gadgHImage};
  436.       gad.selectRender := s.ADR(Images[1]);
  437.     END;
  438.     gad.activation := {I.relVerify,I.gadgImmediate};
  439.     gad.gadgetType := I.boolGadget;
  440.     gad.gadgetRender := s.ADR(Images[0]);
  441.   END;
  442.  
  443.   WDO.magic      := WB.diskMagic;
  444.   WDO.version    := WB.diskVersion;
  445.   WDO.gadget     := gad;
  446.  
  447.   LOOP
  448.  
  449.     doWild := FALSE; zaehler := 0;
  450.     IF ~ol.wbStarted THEN
  451.       zaehler := Dos.MatchFirst(arg,anchor);
  452.       IF (zaehler=0) AND (Dos.itsWild IN anchor.flags) THEN
  453.         doWild := TRUE;
  454.       ELSE Dos.MatchEnd(anchor);
  455.       END;
  456.     END;
  457.  
  458.     LOOP
  459.  
  460.       IF zaehler = Dos.noMoreEntries THEN EXIT END;
  461.  
  462.       IF doWild THEN
  463.         done := FALSE;
  464.         REPEAT
  465.           arg := anchor.buf;
  466.           IF dirs AND (anchor.info.dirEntryType>0) THEN done := TRUE
  467.           ELSE
  468.             oc := st.Occurs(arg,".info");
  469.             IF dirs OR ((oc#-1) AND (oc=st.Length(arg)-5)) OR (anchor.info.dirEntryType>0) THEN
  470.               IF Dos.MatchNext(anchor)=Dos.noMoreEntries THEN EXIT END;
  471.             ELSE done := TRUE;
  472.             END;
  473.           END;
  474.         UNTIL done;
  475.       END;
  476.  
  477.       WDO.type       := WB.tool;
  478.       WDO.defaultTool:= NIL;
  479.       WDO.toolTypes  := NIL;
  480.       WDO.currentX   := WB.noIconPosition;
  481.       WDO.currentY   := WB.noIconPosition;
  482.       WDO.drawerData := NIL;
  483.       WDO.toolWindow := NIL;
  484.       WDO.stackSize  := 0;
  485.  
  486.       IF ~doWild THEN StripInfo(arg) END;
  487.  
  488.       IF ol.wbStarted AND (arg = "") THEN
  489.         lock:=a.GetLock(argNr-1);
  490.         Requests.Assert((lock#NIL) AND Dos.NameFromLock(lock,arg,LEN(arg)),
  491.         "Couldn't access destination!");
  492.          WDO.drawerData := s.ADR(drawerData);
  493.         IF arg[st.Length(arg)-1]=":" THEN
  494.           WDO.type := WB.disk;
  495.           st.Append(arg,"Disk");
  496.         ELSE
  497.           WDO.type := WB.drawer;
  498.         END;
  499.       ELSE
  500.         lock := Dos.Lock(arg,Dos.accessRead);
  501.         IF lock#NIL THEN
  502.           IF Dos.Examine(lock,myFIBlock) THEN
  503.             IF myFIBlock.dirEntryType>0 THEN
  504.               WDO.drawerData := s.ADR(drawerData);
  505.               parent:= Dos.ParentDir(lock);
  506.               IF parent#NIL THEN
  507.                 Dos.UnLock(parent);
  508.                 WDO.type := WB.drawer;
  509.               ELSE
  510.                 WDO.type := WB.disk;
  511.                 st.Append(arg,"Disk");
  512.               END;
  513.             ELSE
  514.               IF fs.Open(in,myFIBlock.fileName,FALSE) THEN
  515.                 IF fs.Read(in,firstLong) THEN
  516.                   IF firstLong#03F3H THEN
  517.                     WDO.type := WB.project;
  518.                     WDO.defaultTool := s.ADR(deftool);
  519.                   END;
  520.                 END;
  521.                 IF fs.Close(in) THEN END;
  522.               END;
  523.             END;
  524.           END;
  525.           Dos.UnLock(lock);
  526.         ELSIF (st.Length(arg)>=4) AND (st.Occurs(arg,"Disk")=st.Length(arg)-4) THEN
  527.           WDO.drawerData := s.ADR(drawerData);
  528.           WDO.type := WB.disk;
  529.         END;
  530.       END;
  531.  
  532.       OldWDO := Icon.GetDiskObject(arg);
  533.       
  534.       IF (source=plainfile) AND (OldWDO=NIL) THEN
  535.         OldWDO:=Icon.GetDefDiskObject(WDO.type);
  536.         Requests.Assert(OldWDO#NIL,"Couldn't get default icon!");
  537.         WDO.gadget:=OldWDO.gadget;
  538.       ELSE
  539.   
  540.         IF OldWDO # NIL THEN
  541.           WDO.type       := OldWDO.type;
  542.           WDO.currentX   := OldWDO.currentX;
  543.           WDO.currentY   := OldWDO.currentY;
  544.           WDO.defaultTool:= OldWDO.defaultTool;
  545.           WDO.toolTypes  := OldWDO.toolTypes;
  546.           WDO.drawerData := OldWDO.drawerData;
  547.           WDO.toolWindow := OldWDO.toolWindow;
  548.           WDO.stackSize  := OldWDO.stackSize;
  549.         END;
  550.  
  551.       END;
  552.  
  553.       IF (WDO.type = WB.project) AND replace
  554.       THEN WDO.defaultTool := s.ADR(deftool);
  555.       END;
  556.       
  557.       IF Icon.PutDiskObject(arg,s.ADR(WDO)) THEN END;
  558.       IF OldWDO#NIL THEN Icon.FreeDiskObject(OldWDO); OldWDO:= NIL; END;
  559.  
  560.       IF (~ol.wbStarted) AND (Dos.PutStr(arg)=Dos.PutStr(".info\n")) THEN END;
  561.  
  562.       IF doWild THEN
  563.         IF Dos.MatchNext(anchor)=Dos.noMoreEntries THEN EXIT END;
  564.       ELSE EXIT;
  565.       END;
  566.  
  567.     END; (* inner LOOP *)
  568.  
  569.     IF doWild THEN Dos.MatchEnd(anchor) END;
  570.  
  571.     IF ~NextArg() THEN EXIT END;
  572.  
  573.   END; (* LOOP *)
  574.  
  575.   IF (~ol.wbStarted) AND (Dos.PutStr("\n--- done\n")#0) THEN END;
  576.  
  577. CLOSE
  578.  
  579.   IF rdargs#NIL THEN Dos.FreeArgs(rdargs);END;
  580.   IF SourceWDO#NIL THEN Icon.FreeDiskObject(SourceWDO);END;
  581.   IF (~ol.wbStarted) AND (Dos.PutStr("\n")#0) THEN END;
  582.  
  583. END Brush2Icon.
  584.